module TranslateLambdaToTemplate where
import PHaskellTypes
import LambdaTypes
import TemplatesTypes
import LambdaTypeDeduction
import TemplateRender
import List

type LambdaDefinitions   = [(String, [LDefinition])] -- [(nombreDefs,[defs])]
 
{-
Transforma los tipos de phaskell a tipos de lambda calculo
-}
lambdaTypeToTemplateType::LambdaType->MetaType
lambdaTypeToTemplateType LtInt            = MetaTypeInteger
lambdaTypeToTemplateType LtBool           = MetaTypeBoolean
lambdaTypeToTemplateType (LtArrow t t')   = MetaArrow (lambdaTypeToTemplateType t) (lambdaTypeToTemplateType t')
lambdaTypeToTemplateType (LUserDef typeName)  = MetaUserDef typeName
lambdaTypeToTemplateType t                    = MetaTypeUnknown
 

{-
Toma un conjunto de definiciones perteneciente y genera 
una lista de LambdaDefinitions [(String, [LDefinition])] 
donde [(name, lista con todos los sc de nombre "name")] 
-}
buildDefinitionList::LProgram->LambdaDefinitions
buildDefinitionList lambdaProgram = buildDefinitionList' lambdaProgram []

buildDefinitionList'::LProgram->LambdaDefinitions->LambdaDefinitions
buildDefinitionList' (def:lambdaProgram) defs = buildDefinitionList' lambdaProgram (mergeDefinition def defs) 
buildDefinitionList' []                  defs =  defs

mergeDefinition::LDefinition->LambdaDefinitions->LambdaDefinitions
mergeDefinition newdef@(LDefinition name e locals)  defs =  case (lookup name defs) of
															Nothing         ->  defs++[(name, [newdef])]
															                    --(abajo) borramo el viejo y agregamos el nuevo
															Just ds         -> (delete (name, ds) defs) ++ [(name, newdef:ds)] 
 

{-
Translate a list of definitions to Metaprogram
-}
translateFromLambdaToTemplates::LambdaDefinitions->MetaProgram
translateFromLambdaToTemplates lambdaProgram = map translateLambdaDefinition lambdaProgram
 
  
{-
Translate a list belong to one supercombinator to a Metafunction
-}
translateLambdaDefinition::(String, [LDefinition])->MetaFunction
translateLambdaDefinition (fname, [])    = error (fname++" no contiene definiciones")
translateLambdaDefinition (fname, defs)  = MetaFunction fname (translateDefs defs) 

{-
Transforma una lista de definiciones lambda en una lista de 
Arboles de expresiones MetaTreeExp
Bridge to translateDefs'
-}
translateDefs::[LDefinition]->[MetaTreeExp]
translateDefs defd =  translateDefs' defd []

--[[]]def  DEBE	DEVOLVER UN ARBOL (MetaDefinition) 
translateDefs'::[LDefinition]->[MetaTreeExp]->[MetaTreeExp]
translateDefs' ((LDefinition fname e locals):ds)  tree  = translateDefs' ds tree'
															where 
																tree' = metaTreeMerge tree (translateDef e locals)

translateDefs' [] []                                       = error "Error1"

-- Ojo que pasa so  hay mas de un elemento?
translateDefs' [] tree                                     = tree


{-
Traduce una exprecion lambda a un MetaNodo o 
a una MetaLeaft 
locals: Son las definiciones locales para poner dentro de
la hoja
 
Nota: este metodo de mapear todos los lambda seguidos como MetaNode
hasta llegar a algo distinto de lambda funciona porque se aplico
antes el Lambda Lifting.
-}
translateDef::LExp->LProgram->MetaTreeExp
translateDef  (LLambda e1 theta e) locals  = MetaNode (metaParameter, metaTheta) [metaDefExp]
										  	   where
										  	   	metaTheta     = lambdaTypeToTemplateType theta
										  	   	metaDefExp    = translateDef  e locals
										  	   	metaParameter = translateEval e1
--Este caso llegamos a la main expresion y 
--generamos un leaft						  	   	
translateDef e  locals                    = MetaLeaft (translateEval  e )  (translateFromLambdaToTemplates (buildDefinitionList locals))

 
		
translateEval::LExp->MetaExp
translateEval  (LVariable var)     = MetaVariable (var )						
translateEval  (LInteger number)   = MetaInteger number
translateEval  (LBoolean boolean)  = MetaBoolean boolean 
translateEval  (LApp e e')         = MetaApp (translateEval  e ) (translateEval e' )
translateEval  (LTypeConstructor name exps) = MetaTypeConstructor name (map translateEval exps) 
translateEval  (LIf e e' e'')      = MetaIf (translateEval e) (translateEval e') (translateEval e'')
translateEval  (LIfOnly e e')      = MetaIfOnly (translateEval e) (translateEval e')
											
	
renderUserTypesDefinitions::LUserDefinedTypes->String	
renderUserTypesDefinitions typesDefinitions = concat (map renderUserTypesDefinition typesDefinitions) 

renderUserTypesDefinition::(String, [LConstructorType])->String
renderUserTypesDefinition (name, constructors) =    "/* Type: "++name++" */\n"
                                                 ++ (concat (map renderTypeConstructor constructors))
                                                
renderTypeConstructor::LConstructorType->String
renderTypeConstructor (LConstructorType constructorName types) =   renderTemplateHeaderTypes types  
                                                                 ++ "struct "++constructorName
                                                                 ++"{\n"
                                                                 ++  typeDef (null types)
                                                                 ++"};\n\n"
                                                                 
                                                                 where
                                                                 	typeDef False = "typedef "++ constructorName ++ "<"++ typedefVariableList 0 ((length types)) ++"> "++ " value;\n"
                                                                 	typeDef True  = "typedef "++ constructorName ++ " value;\n"
typedefVariableList::Int->Int->String
typedefVariableList b end  | b /= (end-1)  = "x"++(show b)++ ", " ++ (typedefVariableList (b+1) end)
						   | otherwise     = "x"++(show b)


renderTemplateHeaderTypes::[LambdaType]->String                                               
renderTemplateHeaderTypes []  = "template< class = void >\n" 										 														
renderTemplateHeaderTypes xs  = "template< "++ (renderTemplateTypes xs 0)++" >\n"


renderTemplateTypes::[LambdaType]->Int->String  
renderTemplateTypes  []    n = ""
renderTemplateTypes  [x]   n = "class "++"x"++(show n)
renderTemplateTypes (x:xs) n = "class "++"x"++(show n)++", " ++renderTemplateTypes xs (n+1)


buildTemplateInitialContext::LUserDefinedTypes->Context
buildTemplateInitialContext ldefTypes  = ([PMetaPrograms],[], getAllConstructorsName ldefTypes)




